home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / pcxbgi2.exe / TPDEMO2.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1991-03-02  |  3.6 KB  |  147 lines
  1. {**************************************************************************
  2. *  Program: TPDemo2.pas                                                   *
  3. *   Author: Marty Balash                                                  *
  4. *     Date: 03/02/91                                                      *
  5. *  Remarks: How to display multiple .MJB images using Turbo Pascal        *
  6. *                                                                         *
  7. *  NOTE:  See TPDemo1.pas for more comments                               *
  8. *         DEMO.PCX was used to create the images                          *
  9. **************************************************************************}
  10.  
  11. program tpdemo;
  12. uses crt,graph;
  13.  
  14. const basefn1 = 'BGI1';
  15. const basefn2 = 'BGI2';
  16. const basefn3 = 'BGI3';
  17. const basefn4 = 'BGI4';
  18. const basefn5 = 'BGI5';
  19. const basefn6 = 'BGI6';
  20. const basefn7 = 'BGI7';
  21. const basefn8 = 'BGI8';
  22. const imsize  = 7702; { In PCX2BGI.EXE, all images were framed (as partial
  23.             screens) and saved to same size files }
  24.  
  25. type imagehdr = record
  26.   id      : array [1..8] of char;
  27.   size    : word;
  28.   palette : palettetype;
  29. end;
  30.  
  31. type imagedata =    { All images are same size, so only one type is needed }
  32.   array[1..imsize] of byte;
  33.  
  34. var
  35.   hdr:imagehdr; { only need one header - all images are from same screen }
  36.   dat: array [1..8] of imagedata; { array of 8 image buffers }
  37.   hdrhandle:file of imagehdr;
  38.   dathandle:file of imagedata;
  39.   datfn: array [1..8] of string[12];
  40.   i,a:integer; { work vars }
  41.   pageflag:integer; { needed by pageflip procedure }
  42.  
  43. procedure openegascreen;          { Open 640x350 16-color EGA screen }
  44. var
  45.   driver,mode,result:integer;
  46. begin
  47.   driver := ega;
  48.   mode := egahi;
  49.   initgraph(driver,mode,'');
  50.   result := graphresult;
  51.   if result <> grok then
  52.     begin
  53.       write('ERROR: ',grapherrormsg(result));
  54.       exit;
  55.     end;
  56. end;
  57.  
  58. procedure readimage;
  59. var
  60.   hdrname:string[7];
  61.   hdrfn:string[12];
  62. begin
  63.   hdrfn:=basefn1+'.HDR';
  64.   datfn[1]:=basefn1+'.DAT';
  65.   datfn[2]:=basefn2+'.DAT';
  66.   datfn[3]:=basefn3+'.DAT';
  67.   datfn[4]:=basefn4+'.DAT';
  68.   datfn[5]:=basefn5+'.DAT';
  69.   datfn[6]:=basefn6+'.DAT';
  70.   datfn[7]:=basefn7+'.DAT';
  71.   datfn[8]:=basefn8+'.DAT';
  72.   assign(hdrhandle,hdrfn);
  73.   {$I-}
  74.   reset(hdrhandle);
  75.   {$I+}
  76.   if ioresult <> 0 then
  77.     exit;
  78.   read(hdrhandle,hdr);
  79.   close(hdrhandle);
  80.   hdrname:=hdr.id[1]+hdr.id[2]+hdr.id[3]+hdr.id[4]+hdr.id[5]+hdr.id[6]+hdr.id[7];
  81.   if hdrname <> 'PCX2BGI' then
  82.     exit;
  83.   setallpalette(hdr.palette);
  84.  
  85.   for i:=1 to 8 do    { read in 8 images }
  86.     begin
  87.       assign(dathandle,datfn[i]);
  88.       {$I-}
  89.       reset(dathandle);
  90.       {$I+}
  91.       if ioresult <> 0 then
  92.         exit;
  93.       read(dathandle,dat[i]);
  94.       close(dathandle);
  95.      end
  96. end;
  97.  
  98. procedure pageflip; { alternate pages for smoother animation }
  99. begin
  100.   if pageflag=1 then
  101.     begin
  102.       pageflag:=0;
  103.       setactivepage(1);
  104.       setvisualpage(0);
  105.     end
  106.   else
  107.     begin
  108.       pageflag:=1;
  109.       setactivepage(0);
  110.       setvisualpage(1);
  111.     end;
  112. end;
  113.  
  114. begin
  115.   openegascreen;
  116.   readimage;
  117.   a:=10;
  118.   pageflag:=0;
  119.   repeat
  120.     if a>220 then
  121.       begin
  122.     for i:= 8 downto 1 do
  123.     begin
  124.       putimage(a,125,dat[i],NormalPut);
  125.       delay(100);
  126.       pageflip;
  127.     end;
  128.     delay(1000);
  129.       end
  130.     else
  131.       begin
  132.     for i:= 8 downto 1 do
  133.     begin
  134.       putimage(a,125,dat[i],NormalPut);
  135.       pageflip;
  136.     end;
  137.     for i:=1 to 8 do
  138.       begin
  139.         putimage(a,125,dat[i],NormalPut);
  140.         pageflip;
  141.     end;
  142.     a:=a+10;
  143.       end;
  144.   until keypressed;
  145.   closegraph;
  146.   writeln('Created with PCX2BGI.EXE by Marty Balash');
  147. end.